home *** CD-ROM | disk | FTP | other *** search
/ Technotools / Technotools (Chestnut CD-ROM)(1993).ISO / lang_oth / tasking / randomnu.mod < prev    next >
Text File  |  1986-03-10  |  2KB  |  92 lines
  1. IMPLEMENTATION MODULE RandomNumbers;
  2.  
  3.   (*
  4.     Additive Number Generator
  5.     from Knuth, Seminumerical Algorithms, 2nd ed. p. 27, 171
  6.   *)
  7.  
  8.   FROM TimeDate IMPORT GetTime, Time;
  9.   FROM SYSTEM IMPORT SETREG, GETREG, CODE, AX, BX;
  10.  
  11.   CONST
  12.     base = 32700;
  13.  
  14.   VAR
  15.     IA: ARRAY [1 .. 55] OF INTEGER;
  16.     JRAND: CARDINAL;
  17.     time: Time;
  18.  
  19.   PROCEDURE srand(IX: INTEGER);
  20.     VAR
  21.       I, II: INTEGER;
  22.       J, K: INTEGER;
  23.     BEGIN
  24.       IX := IX MOD base;
  25.       IF IX < 0 THEN IX := - IX END;
  26.       IA[55] := IX;
  27.       J := IX;
  28.       K := 1;
  29.       FOR I := 1 TO 54 DO
  30.     II := 21 * I MOD 55;
  31.     IA[II] := K;
  32.     K := J - K;
  33.     IF K < 0 THEN
  34.       INC(K, base);
  35.     END;
  36.     J := IA[II];
  37.       END;
  38.       IRN; (* rev it up as D.K. sayes *)
  39.       IRN;
  40.       IRN;
  41.     END srand;
  42.  
  43.   PROCEDURE irand(limit: INTEGER): INTEGER ;
  44.     VAR
  45.       val: INTEGER;
  46.     BEGIN
  47.       INC(JRAND);
  48.       IF JRAND > 55 THEN
  49.     IRN;
  50.       END;
  51. (*
  52.       RETURN TRUNC(FLOAT(IA[JRAND]) * FLOAT(limit) / FLOAT(base));
  53. *)
  54.       val := IA[JRAND];
  55.       SETREG(AX, limit);
  56.       SETREG(BX, val);
  57.       CODE(0F7H, 0E3H);     (* MULW BX *)
  58.       SETREG(BX, base);
  59.       CODE(0F7H, 0F3H);     (* DIVW BX *)
  60.       GETREG(AX, val);
  61.       RETURN val;
  62.     END irand;
  63.  
  64.   PROCEDURE IRN;
  65.     VAR
  66.       i: INTEGER;
  67.       j: INTEGER;
  68.     BEGIN
  69.       FOR i := 1 TO 24 DO
  70.     j := IA[i] - IA[i + 31];
  71.     IF j < 0 THEN
  72.       INC(j, base);
  73.     END;
  74.     IA[i] := j;
  75.       END;
  76.       FOR i := 25 TO 55 DO
  77.     j := IA[i] - IA[i - 24];
  78.     IF j < 0 THEN
  79.       INC(j, base);
  80.     END;
  81.     IA[i] := j;
  82.       END;
  83.       JRAND := 1;
  84.     END IRN;
  85.  
  86.   BEGIN
  87.     GetTime(time);
  88.     (*$R-*)
  89.     srand(VAL(INTEGER, time.day + time.minute + time.millisec));
  90.     (*$R=*)
  91.   END RandomNumbers.
  92.